structure MakeGraph :
    sig
	val instrs2graph : Assem.instr list -> Flow.flowgraph * Graph.node list
	val show : TextIO.outstream -> (Flow.flowgraph * Graph.node list) -> unit
    end =

struct

  structure E = ErrorMsg
  structure G = Graph
  structure GB = Graph.Table
  structure I = Assem
  structure M = Temp
  structure O = Option
  structure S = Symbol
  structure U = UnparseAbsyn
  structure W = Flow
  structure Z = Int
		
  fun instrs2graph instrs = let val control = G.newGraph ()
				val def = ref GB.empty
				val use = ref GB.empty
				val ismove = ref GB.empty
			    in let val nodes = map (fn i => G.newNode control) instrs
			       in ( let val nextnodes = case nodes
							 of []      => []
							  | (_::ns) => ((map (fn n => SOME n) ns)@[NONE])
					fun app3 f []      []      []      = ()
					  | app3 f (x::xs) (y::ys) (z::zs) = ( f (x, y, z)
									     ; app3 f xs ys zs
									     )
					  | app3 _ _       _       _       = E.impossible "FLOWGRAPH: |INSTRS| <> |NODES| <> |NEXTNODES|"
					fun findLabeledNodes [] _                          _       = []
					  | findLabeledNodes _  []                         []      = []
					  | findLabeledNodes _  []                         _       = E.impossible "FLOWGRAPH: LESS INSTRUCTIONS THAN NODES"
					  | findLabeledNodes _  _                          []      = E.impossible "FLOWGRAPH: MORE INSTRUCTIONS THAN NODES"
					  | findLabeledNodes ls ((I.LABEL {assem, lab})::is) (n::ns) = let val ns' = findLabeledNodes ls is ns
												       in if List.exists (fn l => S.unique(l)=S.unique(lab)) ls
													  then n::ns'
													  else ns'
												       end
					  | findLabeledNodes ls (_                   ::is) (_::ns) = findLabeledNodes ls is ns
				    in let fun processInstr (I.OPER  {assem, dst, src, jump=NONE},      n, SOME n') = ( G.mk_edge {from=n, to=n'}
														      ; def := GB.enter (!def, n, dst)
														      ; use := GB.enter (!use, n, src)
														      )
					     | processInstr (I.OPER  {assem, dst, src, jump=NONE},      n, NONE   ) = ( def := GB.enter (!def, n, dst)
														      ; use := GB.enter (!use, n, src)
														      )
					     | processInstr (I.OPER  {assem, dst, src, jump=(SOME ls)}, n, _      ) = ( app (fn n' => G.mk_edge {from=n, to=n'})
															    (findLabeledNodes ls instrs nodes)
														      ; def := GB.enter (!def, n, dst)
														      ; use := GB.enter (!use, n, src)
														      )
					     | processInstr (I.MOVE  {assem, dst, src},                 n, SOME n') = ( G.mk_edge {from=n, to=n'}
														      ; def := GB.enter (!def, n, [dst])
														      ; use := GB.enter (!use, n, [src])
														      ; ismove := GB.enter (!ismove, n, true)
														      )
					     | processInstr (I.MOVE  {assem, dst, src},                 n, NONE)    = ( def := GB.enter (!def, n, [dst])
														      ; use := GB.enter (!use, n, [src])
														      ; ismove := GB.enter (!ismove, n, true)
														      )
					     | processInstr (I.LABEL {assem, lab},                      n, SOME n') = G.mk_edge {from=n, to=n'}
					     | processInstr (I.LABEL {assem, lab},                      n, NONE)    = ()
				       in ( app3 processInstr
						 instrs
						 nodes
						 nextnodes
					  ; (W.FGRAPH { control = control
						      , def = !def
						      , use = !use
						      , ismove = !ismove},
					     nodes)
					  )
				       end
				    end
				  )
			       end
			    end

  fun show stream (W.FGRAPH {control, def, use, ismove}, nodes) =
      let val _ = TextIO.print ("Nodecount: " ^ Z.toString (length nodes) ^ "\n")
	  val (_, nodeNumberTable) = foldl (fn (n, (i, nt)) => (i+1,
								GB.enter (nt, n, i)))
					   (0, GB.empty)
					   nodes
	  fun nodeName n = "(" ^ Z.toString (O.getOpt (GB.look (nodeNumberTable, n), ~1)) ^ ")"
	  fun tempNames (tab, n) = map M.makestring (O.getOpt (GB.look (tab, n), []))
      in app (fn n => ( TextIO.output (stream, (nodeName n)
					       ^ " ---> "
					       ^ (U.commaSep (map nodeName (G.succ n)))
					       ^ " DEFS: "
					       ^ (U.commaSep (tempNames (def, n)))
					       ^ "    USES: "
					       ^ (U.commaSep (tempNames (use, n)))
					       ^ "\n")
		      ; TextIO.flushOut stream
		      ))
	     nodes
      end
end
